home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr01 / halcn305.zip / GSDMO_17.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-02  |  6KB  |  180 lines
  1. program GSDMO_17;
  2. {-----------------------------------------------------------------------------
  3.                              DBase Status Checker
  4.  
  5.        Copyright (c)  Richard F. Griffin
  6.  
  7.        30 January 1993
  8.  
  9.        102 Molded Stone Pl
  10.        Warner Robins, GA  31088
  11.  
  12.        -------------------------------------------------------------
  13.  
  14.        Demonstrates use of status checking for long duration operations
  15.  
  16.        Several functions in GS_dBase can take some time to complete
  17.        (e.g., IndexOn and Pack).  For this reason, a 'hook' is available
  18.        to allow the user to gain access and track progress.  The default
  19.        procedure DefCapStatus ignores the status.  If the user chooses to
  20.        take advantage of progress reporting, it is done by replacing
  21.        DefCapStatus with his or her own routines via SetStatusCapture.
  22.        The status may be ignored again later by setting the default
  23.        via SetCaptureStatus(DefCapStatus).
  24.  
  25.        The following is an example of inserting a user-supplied status
  26.        reporting procedure.  This sample program demonstrates how this
  27.        procedure may be installed in a user's program.  All calls to
  28.        StatusUpdate anywhere in the file object's heirarchy will come
  29.        through this 'hook'.
  30.  
  31.        Constants passed as arguments are contained in the GSOB_VAR unit,
  32.        they are:
  33.  
  34.        StatusStart     = -1;   Passed to indicate a routine will be passing
  35.                                status update information.
  36.  
  37.        StatusStop      = 0;    Signals termination by a routine, cancelling
  38.                                status update processing.
  39.  
  40.        StatusIndexTo   = 1;    Token for identifying IndexTo as the routine
  41.                                passing status information during sort phase.
  42.  
  43.        StatusIndexWr   = 2;    Token for identifying IndexTo as the routine
  44.                                passing status information during write phase.
  45.  
  46.        StatusSort      = 5;    Token for identifying Sort as the routine
  47.                                passing status information.
  48.  
  49.        StatusCopy      = 6;    Token for identifying Copy as the routine
  50.                                passing status information during file writing.
  51.  
  52.        StatusPack      = 11;   Token for identifying Pack as the routine
  53.                                passing status information.
  54.  
  55.        GenFStatus      = 901;  Token for file record creation report.
  56.  
  57.        The structure of a StatusUpdate call is:
  58.  
  59.        StatusUpdate(statword1, statword2, statword3);
  60.  
  61.        where the statword* values are type longint and will vary depending on
  62.        the contents of statword1.  For example:
  63.  
  64.        if     statword1 = StatusStart
  65.        then:  statword2 = the calling routine token (StatusIndexTo or
  66.                           StatusPack.
  67.               statword3 = the number of records to be processed.
  68.  
  69.        if     statword1 = StatusStop
  70.        then:  statword2 = 0
  71.               statword3 = 0
  72.  
  73.        if      statword1 = StatusCopy/StatusIndexTo/StatusPack/StatusSort
  74.        then:   statword2 = current record number being processed
  75.                statword3 = 0
  76.  
  77.        if      statword1 = StatusIndexWr
  78.        then:   statword2 = current record number being processed
  79.                statword3 = Pass number
  80.  
  81.        New procedures/functions introduced are:
  82.  
  83.                  DeleteRec
  84.                  Pack
  85.                  SetExclusiveOn
  86.                  SetStatusCapture
  87.  
  88. ------------------------------------------------------------------------------}
  89.  
  90. uses
  91.    GSOB_Var,
  92.    GSOBShel,
  93.    GSOB_Gen,
  94.    {$IFDEF WINDOWS}
  95.       WinCRT,
  96.       WinDOS;
  97.    {$ELSE}
  98.       CRT,
  99.       DOS;
  100.    {$ENDIF}
  101.  
  102.  
  103. var
  104.    i       : integer;
  105.  
  106. {-----------------------------------------------------------------------------}
  107. {$F+}
  108. Procedure UserCaptureStatus(stat1,stat2,stat3 : longint);
  109. begin
  110.    case stat1 of
  111.       StatusStart  : begin
  112.                         GotoXY(1,WhereY);
  113.                         case stat2 of
  114.                             StatusPack  :  system.write('[ Pack Progress ]');
  115.                             StatusIndexTo :
  116.                                     system.write('[ Index Sort Progress ]');
  117.                             StatusIndexWr :
  118.                                     system.write('[ Index Write Progress ]');
  119.                             GenFStatus      :
  120.                                     system.write('[ Creation Progress ]');
  121.                          end;
  122.                          Writeln;
  123.                          GotoXY(26,WhereY);
  124.                          system.write('Total Records to Process = ',stat3);
  125.                       end;
  126.       StatusStop    : begin
  127.                          GoToXY(79,WhereY);
  128.                          Writeln;
  129.                          Writeln('Finished');
  130.                       end;
  131.       GenFStatus,
  132.       StatusPack,
  133.       StatusIndexTo : begin
  134.                          GoToXy(1,WhereY);
  135.                          system.write('Record Number ',stat2,'  ');
  136.                       end;
  137.       StatusIndexWr : begin
  138.                          GoToXy(1,WhereY);
  139.                          system.write('Record Number ',stat2,'  ');
  140.                          GoToXy(60,WhereY);
  141.                          system.write('Pass Number ',stat3,'  ');
  142.                       end;
  143.    end;
  144. end;
  145. {$F-}
  146. {----------------------------------------------------------------------------}
  147.  
  148.  
  149. {                               Main Program                                 }
  150.  
  151.  
  152. begin
  153.    ClrScr;
  154.    SetExclusiveOn;                      {Must be exclusive for Pack to work}
  155.    SetStatusCapture(UserCaptureStatus);
  156.  
  157.    writeln('Creating GSDMO_17.DBF');
  158.    MakeTestData(3,'GSDMO_17', 0, false);
  159.    writeln('GSDMO_17.DBF Created');
  160.  
  161.    Select(1);
  162.    Use('GSDMO_17');
  163.    AddTestData(DBFActive,500);
  164.    IndexOn('GSDMO_17','LASTNAME');
  165.    i := 1;
  166.    GoTop;
  167.    while not dEOF do
  168.    begin
  169.       writeln(i:6,'  ',
  170.               FieldGet('LASTNAME'),'   ',
  171.               FieldGet('FIRSTNAME'),
  172.               RecNo:8);
  173.       if odd(i) then DeleteRec;
  174.       Skip(1);
  175.       inc(i);
  176.    end;
  177.    Pack;               {will also reindex}
  178.    CloseDataBases;
  179. end.
  180.